module Gml.Parse (

        parseGml

) where

import Gml.Token
import Numeric
import Control.Monad
import Text.ParserCombinators.Parsec

parseGml :: String -> [GmlToken]
parseGml input = case parse parseList "gml" input of
    Left err -> error ("Parse error: " ++ (show err))
    Right gml -> gml

parseGml'' = liftM2 const parseGml' spaces

parseList = many parseGml''

parseGml' =
        -- structures
        parseFunction
    <|> parseArray
        -- control operators
    <|> parseControlOperators
        -- number operators
    <|> parseNumberOperators
        -- points
    <|> parsePointOperators
        -- arrays
    <|> parseArrayOperators
        -- types
    <|> parseBool
    <|> parseInteger
    <|> parseString
        -- environment
    <|> parseBinder
    <|> parseIdentifier

parseArray = parseSequence '[' ']' ArrayToken
parseFunction = parseSequence '{' '}' FunctionToken
parseSequence start end token = do char start
                                   spaces
                                   array <- parseList
                                   spaces
                                   char end
                                   return $ token array

parseControlOperators = parseApply <|> parseIf
parseApply = do keyword "apply"
                return $ ApplyToken
parseIf = do keyword "if"
             return $ IfToken

parseNumberOperators = do keyword "addi"
                          return $ AddiToken
                   <|> do keyword "addf"
                          return $ AddfToken
                   <|> do keyword "acos"
                          return $ ACosToken
                   <|> do keyword "asind"
                          return $ ASinToken
                   <|> do keyword "clampf"
                          return $ ClampfToken
                   <|> do keyword "cos"
                          return $ CosToken
                   <|> do keyword "divi"
                          return $ DiviToken
                   <|> do keyword "divf"
                          return $ DivfToken
                   <|> do keyword "eqi"
                          return $ EqiToken
                   <|> do keyword "eqf"
                          return $ EqfToken
                   <|> do keyword "floor"
                          return $ FloorToken
                   <|> do keyword "frac"
                          return $ FracToken
                   <|> do keyword "lessi"
                          return $ LessiToken
                   <|> do keyword "lessf"
                          return $ LessfToken
                   <|> do keyword "modi"
                          return $ ModiToken
                   <|> do keyword "muli"
                          return $ MuliToken
                   <|> do keyword "mulf"
                          return $ MulfToken
                   <|> do keyword "negi"
                          return $ NegiToken
                   <|> do keyword "negf"
                          return $ NegfToken
                   <|> do keyword "real"
                          return $ ToRealToken
                   <|> do keyword "sin"
                          return $ SinToken
                   <|> do keyword "Sqrt"
                          return $ SqrtToken
                   <|> do keyword "subi"
                          return $ SubiToken
                   <|> do keyword "subf"
                          return $ SubfToken

parsePointOperators = do keyword "getx"
                         return $ GetXToken
                  <|> do keyword "gety"
                         return $ GetYToken
                  <|> do keyword "getz"
                         return $ GetZToken
                  <|> do keyword "point"
                         return $ CreatePointToken

parseArrayOperators = do keyword "get"
                         return $ GetToken
                  <|> do keyword "length"
                         return $ LengthToken

keyword s = try (string s) >> notFollowedBy (letter <|> digit) >> spaces

parseInteger = liftM (IntToken . read) $ many1 digit
--parseInteger = do int <- manyTill digit (char '.')
--                  return $ IntToken (read int)
parseBool = do keyword "true"
               return $ BoolToken True
        <|> do keyword "false"
               return $ BoolToken False
parseString = do char '"'
                 string <- many (noneOf "\"")
                 char '"'
                 spaces
                 return $ StringToken string

parseBinder = do char '/'
                 binder <- many1 (noneOf " ]}\n\t")
                 spaces
                 return $ BinderToken binder
parseIdentifier = do identifier <- many1 (noneOf " ]}\n\t")
                     spaces
                     return $ IdentifierToken identifier